home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / mobile / fma-2.0-stable-setup.exe / {app} / source / uCalling.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2005-01-26  |  13.5 KB  |  458 lines
  1. unit uCalling;
  2.  
  3. {
  4. *******************************************************************************
  5. * Descriptions: Calling/Called Popup Implementation
  6. * $Source: /cvsroot/fma/fma/uCalling.pas,v $
  7. * $Locker:  $
  8. *
  9. * Todo:
  10. *   - Update to support note taking for the active caller
  11. *
  12. * Change Log:
  13. * $Log: uCalling.pas,v $
  14. * Revision 1.14.6.1  2005/01/25 16:03:07  z_stoichev
  15. * Merged with 2.1 Beta 1 bugfixes
  16. *
  17. * Revision 1.14  2004/07/07 09:41:41  z_stoichev
  18. * Common image usage
  19. * bugfixes.
  20. *
  21. * Revision 1.13  2004/07/06 14:06:52  z_stoichev
  22. * - Added Personalization default contact image.
  23. *
  24. * Revision 1.12  2004/06/29 15:23:54  z_stoichev
  25. * Add Call support without popups.
  26. *
  27. * Revision 1.11  2004/06/29 10:46:54  z_stoichev
  28. * Updated personalization
  29. * Added Call notes support
  30. *
  31. * Revision 1.10  2004/06/28 23:02:21  z_stoichev
  32. * Personalization and GUI changed.
  33. *
  34. * Revision 1.9  2004/06/15 15:30:30  z_stoichev
  35. * - Added Default Ringing sound support.
  36. * - Added Default Busy sound support.
  37. * - Added Handle RING signals (default sound).
  38. * - Added Second Incoming call is ignored.
  39. * - Added Cancel Incoming call silently support.
  40. * - Added Cancel Outgoing call warning message.
  41. *
  42. * Revision 1.8  2004/06/08 19:19:25  lordlarry
  43. * Memory Leak fixed
  44. *
  45. * Revision 1.7  2003/12/11 14:08:02  z_stoichev
  46. * Fixed Command return error on answer.
  47. * Timer and sound start adjusted to match phone ones.
  48. * Handle some possible exceptions.
  49. *
  50. * Revision 1.6  2003/11/28 09:38:07  z_stoichev
  51. * Merged with branch-release-1-1 (Fma 0.10.28c)
  52. *
  53. * Revision 1.5.2.8  2003/11/21 13:34:11  z_stoichev
  54. * Fixed headset button mark call as missed issue.
  55. *
  56. * Revision 1.5.2.7  2003/11/14 15:41:02  z_stoichev
  57. * Updates for patch 27d.
  58. *
  59. * Revision 1.5.2.6  2003/11/13 16:35:39  z_stoichev
  60. * Fixed personalization support.
  61. *
  62. * Revision 1.5.2.5  2003/11/12 16:48:52  z_stoichev
  63. * Do not show error on missing sound file.
  64. *
  65. * Revision 1.5.2.4  2003/11/12 15:19:03  z_stoichev
  66. * Temporary disconnect phone (during call) support.
  67. * Image auto-scale to fit.
  68. *
  69. * Revision 1.5.2.3  2003/11/11 18:11:06  z_stoichev
  70. * Add background image.
  71. * Show contact picture and play sound
  72. * if personalized in phonebook.
  73. *
  74. * Revision 1.5.2.2  2003/10/31 14:51:15  z_stoichev
  75. * Added headset button (disconnect on answer).
  76. *
  77. * Revision 1.5.2.1  2003/10/27 07:22:54  z_stoichev
  78. * Build 0.1.0 RC1 Initial Checkin.
  79. *
  80. * Revision 1.5  2003/10/15 15:49:55  z_stoichev
  81. * MIssed Calls Unicode support.
  82. * GUI changes.
  83. *
  84. * Revision 1.4  2003/02/17 06:51:16  crino77
  85. * Added support for missed calls
  86. *
  87. * Revision 1.3  2003/01/30 04:15:57  warren00
  88. * Updated with header comments
  89. *
  90. *
  91. *******************************************************************************
  92. }
  93.  
  94. interface
  95.  
  96. uses
  97.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  98.   Dialogs, StdCtrls, Placemnt, TntStdCtrls, GR32_Image, ExtCtrls, MPlayer,
  99.   jpeg, MMSystem, uSyncPhonebook;
  100.  
  101. type
  102.   TfrmCalling = class(TForm)
  103.     HandupButton: TButton;
  104.     AnswerButton: TButton;
  105.     FormPlacement1: TFormPlacement;
  106.     lbAlpha: TTntLabel;
  107.     lbNumber: TTntLabel;
  108.     HeadsetButton: TButton;
  109.     ImagePanel: TPanel;
  110.     Image32: TImage32;
  111.     MediaPlayer1: TMediaPlayer;
  112.     Image1: TImage;
  113.     lblTime: TLabel;
  114.     TimeTimer: TTimer;
  115.     Memo: TTntMemo;
  116.     procedure CallButtonClick(Sender: TObject);
  117.     procedure FormShow(Sender: TObject);
  118.     procedure MediaPlayer1Notify(Sender: TObject);
  119.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  120.     procedure FormCreate(Sender: TObject);
  121.     procedure TimeTimerTimer(Sender: TObject);
  122.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  123.   private
  124.     { Private declarations }
  125.     FContact: PContactData;
  126.     FStartTime: TDateTime;
  127.     FPersonalized,FStopped: boolean;
  128.     FIsIncoming: Boolean;
  129.     FRingSecs,FRingOn: integer;
  130.     FCheck,FCalling: Boolean;
  131.     FCustomImage: Boolean;
  132.     procedure Set_IsIncoming(const Value: Boolean);
  133.     function Get_Busy: Boolean;
  134.     procedure Set_Busy(const Value: Boolean);
  135.     procedure Set_CustomImage(const Value: Boolean);
  136.   public
  137.     { Public declarations }
  138.     procedure CreateCall(Number: WideString; Popup: boolean; AlphaBlend: Integer);
  139.     procedure DoPersonalize;
  140.     procedure DoResizeWide;
  141.     procedure StopPersonalize(HidePic: boolean = True);
  142.     function HasPersonalizedSound: boolean;
  143.   published
  144.     property IsIncoming: Boolean read FIsIncoming write Set_IsIncoming;
  145.     property IsTalking: Boolean read FCheck write FCheck;     { means: Are we picked up the call }
  146.     property IsCalling: Boolean read FCalling write FCalling; { means: Should we hang up or not on exit? }
  147.     property IsPersonalized: Boolean read FPersonalized;      { means: Do we have personalized contact? }
  148.     property IsCustomImage: Boolean read FCustomImage write Set_CustomImage;
  149.     property IsBusy: Boolean read Get_Busy write Set_Busy;    { means: Is busy signal detected? }
  150.   end;
  151.  
  152. var
  153.   frmCalling: TfrmCalling;
  154.  
  155. implementation
  156.  
  157. uses Unit1, uMissedCalls;
  158.  
  159. const
  160.   DefRingOutgoingSecs = 5;
  161.  
  162. {$R *.dfm}
  163.  
  164. procedure TfrmCalling.CallButtonClick(Sender: TObject);
  165. begin
  166.   if Sender = HandupButton then begin
  167.     StopPersonalize;
  168.     try
  169.       Form1.VoiceHangUp;
  170.     except
  171.     end;
  172.   end
  173.   else
  174.   if Sender = AnswerButton then begin
  175.     StopPersonalize(False);
  176.     try
  177.       Form1.VoiceAnswer;
  178.     except // Error may occur if call is alerady active...
  179.     end;
  180.     FCheck := True;
  181.     if Visible and Memo.Visible then
  182.       Memo.SetFocus;
  183.   end
  184.   else
  185.   if Sender = HeadsetButton then begin
  186.     StopPersonalize(False);
  187.     try
  188.       Form1.VoiceAnswer;
  189.     except
  190.     end;
  191.     FCheck := True;
  192.     Form1.DoDisconnectTemporary;
  193.   end;
  194.   (Sender As TButton).Enabled := False;
  195. end;
  196.  
  197. procedure TfrmCalling.FormShow(Sender: TObject);
  198. begin
  199.   SetWindowPos(Handle, HWND_TOPMOST,
  200.     Top, Left, Width, Height,
  201.     SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  202.   { temporary disable this feature
  203.   HeadsetButton.Visible := False;
  204.   {}
  205. end;
  206.  
  207. procedure TfrmCalling.DoPersonalize;
  208. var
  209.   s: string;
  210.   w: WideString;
  211. begin
  212.   { Try to lookup caller and load personalized info about the contact }
  213.   if not FPersonalized then begin
  214.     { Lookup contact name }
  215.     if (lbAlpha.Caption = sUnknownNumber) or (lbAlpha.Caption = sUnknownContact) then
  216.       lbAlpha.Caption := form1.LookupContact(lbNumber.Caption,lbAlpha.Caption);
  217.     { Resize window if needed }
  218.     DoResizeWide;
  219.     { Personalize }
  220.     w := Form1.ExtractContact(lbAlpha.Caption);
  221.     if form1.frmSyncPhonebook.FindContact(w,FContact) then begin
  222.       FPersonalized := True;
  223.       if IsIncoming then
  224.         Form1.ShowBaloonInfo(GetContactFullName(FContact)+' is calling...',60);
  225.       // notes
  226.       if not GetContactNotes(FContact,Memo.Lines) then
  227.         Memo.Clear;
  228.       Memo.Visible := True;
  229.       // image
  230.       try
  231.         IsCustomImage := False;
  232.         ImagePanel.Caption := 'Loading...';
  233.         ImagePanel.Update;
  234.         s := GetContactPictureFile(FContact);
  235.         if s <> '' then begin
  236.           Image32.Bitmap.LoadFromFile(s);
  237.           IsCustomImage := True;
  238.         end;
  239.         Abort; // restore ImagePanel.Caption anyway!
  240.       except
  241.         ImagePanel.Caption := '<no photo>';
  242.       end;
  243.       // sound
  244.       // WaitASec(500); // delay to sync our with phone sounds :)
  245.       try
  246.         s := GetContactSoundFile(FContact);
  247.         if IsIncoming and (s <> '') then begin
  248.           { Stop default ringing sound }
  249.           if IsIncoming then PlaySound(nil, 0, SND_PURGE);
  250.           { Play personalized sound }
  251.           MediaPlayer1.FileName := s;
  252.           MediaPlayer1.Open;
  253.           MediaPlayer1.Play;
  254.           MediaPlayer1.Notify := True;
  255.         end
  256.         else
  257.           MediaPlayer1.FileName := '';
  258.       except
  259.         MediaPlayer1.FileName := '';
  260.       end;
  261.       FStopped := False;
  262.     end
  263.     else begin
  264.       ImagePanel.Caption := '<no photo>';
  265.       Memo.Lines.Clear;
  266.     end;
  267.   end;
  268.   { Hide image and shift the rest to left if not personalized, and center contact name
  269.   if not FPersonalized then begin
  270.     // TODO
  271.   end;
  272.   { Play default ringing sound if no personalization set up for that contact,
  273.     or if personalization is set up, but only for the contact picture, i.e. no sound }
  274.   if (not FPersonalized or (MediaPlayer1.FileName = '')) then
  275.     if IsIncoming then
  276.       FStopped := not PlaySound(pChar('FMA_CallReceived'), 0, SND_ASYNC or SND_APPLICATION or SND_NODEFAULT)
  277.     else
  278.       FStopped := not PlaySound(pChar('FMA_Calling'), 0, SND_ASYNC or SND_APPLICATION or SND_NODEFAULT);
  279. end;
  280.  
  281. procedure TfrmCalling.MediaPlayer1Notify(Sender: TObject);
  282. begin
  283.   { loop sound }
  284.   if FPersonalized and not FStopped and (MediaPlayer1.Mode = mpStopped) then
  285.     try
  286.       MediaPlayer1.Play;
  287.       MediaPlayer1.Notify := True;
  288.     except
  289.     end;
  290. end;
  291.  
  292. procedure TfrmCalling.StopPersonalize(HidePic: boolean);
  293. begin
  294.   if not FStopped then begin
  295.     FStopped := True;
  296.     if HidePic then begin
  297.       { Save contact notes }
  298.       if IsCustomImage and FPersonalized and Assigned(FContact) then
  299.         SetContactNotes(FContact,Memo.Lines);
  300.       IsCustomImage := False;
  301.     end
  302.     else begin
  303.       TimeTimer.Enabled := True;
  304.       FStartTime := Now;
  305.     end;
  306.     if MediaPlayer1.FileName <> '' then
  307.       try
  308.         MediaPlayer1.Notify := False;
  309.         if IsIncoming then
  310.           try
  311.             MediaPlayer1.Stop;
  312.             MediaPlayer1.Close;
  313.           except
  314.           end;
  315.         MediaPlayer1.FileName := '';
  316.       except
  317.       end
  318.     else
  319.       { Stop default ringing sound }
  320.       PlaySound(nil, 0, SND_PURGE);
  321.     Form1.CoolTrayIcon1.HideBalloonHint;
  322.   end;
  323. end;
  324.  
  325. procedure TfrmCalling.FormCloseQuery(Sender: TObject;
  326.   var CanClose: Boolean);
  327. begin
  328.   if IsCalling and not IsTalking and not IsIncoming then
  329.     CanClose := MessageDlg('Closing this box will Hang Up current outgoing call. Continue?',
  330.       mtConfirmation,[mbOk,mbCancel],0) = mrOk;
  331. end;
  332.  
  333. procedure TfrmCalling.FormClose(Sender: TObject; var Action: TCloseAction);
  334. begin
  335.   { Cancel any call attempt. If we're in call do not hang up here! }
  336.   if IsCalling and not IsTalking then
  337.     Form1.VoiceHangUp(IsIncoming);
  338.   { Stop any sound }
  339.   StopPersonalize;
  340.   TimeTimer.Enabled := False;
  341.   Image32.Bitmap.Clear;
  342. end;
  343.  
  344. procedure TfrmCalling.FormCreate(Sender: TObject);
  345. begin
  346.   lbAlpha.Font.Style := lbAlpha.Font.Style + [fsBold];
  347.   Image1.Picture.Assign(Form1.CommonBitmaps.Bitmap[1]);
  348. end;
  349.  
  350. procedure TfrmCalling.TimeTimerTimer(Sender: TObject);
  351. begin
  352.   { This timer will be triggered once a call is active
  353.     or when an outgoing call is sarted }
  354.   if IsTalking then
  355.     lblTime.Caption := FormatDateTime('nn:ss',Now - FStartTime)
  356.   else
  357.     if not IsIncoming then begin
  358.       { perform default outgoing ringing sound on every RingSecs seconds }
  359.       inc(FRingSecs);
  360.       if FRingSecs = FRingOn then begin
  361.         DoPersonalize;
  362.         FRingSecs := 0;
  363.       end;
  364.     end;
  365. end;
  366.  
  367. procedure TfrmCalling.Set_IsIncoming(const Value: Boolean);
  368. begin
  369.   FIsIncoming := Value;
  370.   if Visible then
  371.     if Value then Form1.ShowBaloonInfo('Incoming call...',60);
  372. end;
  373.  
  374. function TfrmCalling.HasPersonalizedSound: boolean;
  375. begin
  376.   Result := FPersonalized and (MediaPlayer1.FileName <> '');
  377. end;
  378.  
  379. function TfrmCalling.Get_Busy: Boolean;
  380. begin
  381.   Result := FRingOn = 1;
  382. end;
  383.  
  384. procedure TfrmCalling.Set_Busy(const Value: Boolean);
  385. begin
  386.   if Value then FRingOn := 1 else FRingOn := DefRingOutgoingSecs;
  387.   FRingSecs := 0;
  388. end;
  389.  
  390. procedure TfrmCalling.CreateCall(Number: WideString; Popup: boolean; AlphaBlend: Integer);
  391. var
  392.   CallName: WideString;
  393. begin
  394.   { Setup variables } 
  395.   FRingSecs := 0;
  396.   FRingOn := DefRingOutgoingSecs;
  397.   FStopped := False;
  398.   FPersonalized := False;
  399.   FCheck := False;
  400.   lblTime.Caption := '00:00';
  401.   FContact := nil;
  402.   Memo.Visible := False;
  403.   HeadsetButton.Enabled := True;
  404.   HeadsetButton.Visible := False;
  405.   AnswerButton.Enabled := True;
  406.   AnswerButton.Visible := False;
  407.   HandupButton.Enabled := True;
  408.   { Prepare transparancy }
  409.   AlphaBlendValue := AlphaBlend;
  410.   { Resize form to fix message }
  411.   if Number = '' then CallName := sUnknownNumber
  412.     else CallName := form1.LookupContact(Number,sUnknownContact);
  413.   lbAlpha.Alignment := taLeftJustify;
  414.   lbAlpha.AutoSize := True;
  415.   lbAlpha.Caption := CallName;
  416.   lbNumber.Caption := Number;
  417.   IsCustomImage := False;  
  418.   { Restore form position }
  419.   FormPlacement1.RestoreFormPlacement;
  420.   Application.ProcessMessages;
  421.   { Resize form }
  422.   DoResizeWide;
  423.   Height := Constraints.MinHeight;
  424.   { Show window but not activate it
  425.   ShowWindow(Handle,SW_SHOWNOACTIVATE);
  426.   ShowWindow(HeadsetButton.Handle,SW_SHOWNOACTIVATE);
  427.   ShowWindow(AnswerButton.Handle,SW_SHOWNOACTIVATE);
  428.   ShowWindow(HandupButton.Handle,SW_SHOWNOACTIVATE);
  429.   ShowWindow(Memo.Handle,SW_SHOWNOACTIVATE);
  430.   ShowWindow(ImagePanel.Handle,SW_SHOWNOACTIVATE);
  431.   ShowWindow(Image32.Handle,SW_SHOWNOACTIVATE);
  432.   {}
  433.   if Popup then
  434.     Show;
  435. end;
  436.  
  437. procedure TfrmCalling.DoResizeWide;
  438. var
  439.   wide: integer;
  440. begin
  441.   wide := lbAlpha.Width;
  442.   if lbNumber.Width > wide then wide := lbNumber.Width;
  443.   wide := wide + lbAlpha.Left - 4;
  444.   if wide > (Constraints.MinWidth-16) then
  445.     ClientWidth := wide + 8
  446.   else
  447.     Width := Constraints.MinWidth;
  448. end;
  449.  
  450. procedure TfrmCalling.Set_CustomImage(const Value: Boolean);
  451. begin
  452.   FCustomImage := Value;
  453.   if not Value then
  454.     Image32.Bitmap.Assign(Form1.CommonBitmaps.Bitmap[0]);
  455. end;
  456.  
  457. end.
  458.